00100		ENTRY TRANSP,DOT,CROSS,TRANSF,SCALE,UNIT,PLUS,DIFFER
00200		ENTRY RESET,MAGNIT,REDUCE,TIMES,MOVEV,MOVET
00300		ENTRY NORMAL,INNER,INVERT,IDENTI,ADPFOR
00400	
00500		EXTERNAL SQRT
00600	
00700		DEFINE POPR & (A) {
00800		SUB P,X&A&A
00900		JRST @A(P)⎇
01000	
01100		↓FF←0
01200		↓A←1
01300		↓B←2
01400		↓C←3
01500		↓D←4
01600		↓X←5
01700		↓Y←6
01800		↓Z←7
01900		↓Q←10
02000		↓AA←11
02100		↓SP←16
02200		↓P←17
02300	
02400		TITLE VECTOR
02500	
02600	↓X11:	1(1)
02700	↓X22:	2(2)
02800	↓X33:	3(3)
02900	↓X44:	4(4)
03000	↓X66:	6(6)
03100	↓ONE:	1.0
03200	↓MLT:	BLOCK 20
     

00100		BEGIN DOT
00200	↑DOT:	HRRZ C,-1(P)		;FIRST VECTOR
00300		HRRZ D,-2(P)		;SECOND VECTOR
00400		MOVE A,(C)
00500		FMPR A,(D)		;A←C1*D1
00600		MOVE B,1(C)
00700		FMPR B,1(D)		;B←C2*D2
00800		FADR A,B		;A←C1*D1+C2*D2
00900		MOVE B,2(C)
01000		FMPR B,2(D)		;B←C3*D3
01100		FADR A,B		;A←C.D
01200		MOVE B,3(C)
01300		FMPR B,3(D)		;W1*W2
01400		FDVR A,B
01500		POPR 3
01600		BEND
01700	
     

00100		BEGIN ADPFOR
00200	↑ADPFOR:
00300	;	ADPFOR(N,A,I,X,EX)
00400	
00500		HRRZ X,-5(P)
00600		HRRZ Y,-3(P)
00700		HRRZ Z,-4(P)
00800		SOJ Y,
00900		IMUL Y,-2(Z)
01000		ADDI Z,(Y)
01100		ADDI X,(Z)
01200		HRRZ Y,-2(P)
01300		MOVN FF,-1(P)
01400		SETZ A,
01500	L1:	MOVE C,(Z)
01600		FMPL C,(Y)
01700		UFA A,D
01800		FADL FF,C
01900		UFA A,B
02000		FADL FF,B
02100		AOJ Z,
02200		CAIGE Z,(X)
02300		AOJA Y,L1
02400		MOVN A,FF
02500		POPR 6
02600		BEND
     

00100		BEGIN CROSS
00200	↑CROSS:HRRZ X,-1(P)
00300		HRRZ Y,-2(P)
00400		HRRZ Z,-3(P)
00500	
00600		MOVE A,3(X)
00700		FMPR A,3(Y)
00800		MOVEM A,3(Z)
00900	
01000		MOVE FF,(X)
01100		MOVE A,1(X)		;A=A2
01200		MOVE B,(Y)		;B=B1
01300		MOVE C,1(Y)		;C=B2
01400	
01500		MOVE D,FF		;D=A1
01600		FMPR D,C		;D=A1B2
01700		MOVE Q,A		;Q=A2
01800		FMPR Q,B		;Q=A2B1
01900		FSBR Q,D		;Q=A1B2-A2B1
02000	
02100		MOVE D,2(Y)		;D=B3
02200		FMPR FF,D		;FF=A1B3
02300		MOVE Y,2(X)		;Y=A3
02400		FMPR B,Y		;B=A3B1
02500		MOVEM Q,2(Z)
02600		FSBR FF,B		;FF=A3B1-A1B3
02700		MOVEM FF,1(Z)
02800	
02900		FMPR A,D
03000		FMPR Y,C
03100		FSBR Y,A
03200		MOVEM Y,(Z)
03300		POPR 4
03400		BEND
     

00100		BEGIN INNER
00200	↑INNER:	HRRZ Z,-2(P)
00300		HRRZ Y,-1(P)
00400		MOVE A,(Z)
00500		FMPR A,(Y)
00600		MOVE B,1(Z)
00700		FMPR B,1(Y)
00800		FADR A,B
00900		MOVE B,2(Z)
01000		FMPR B,2(Y)
01100		FADR A,B
01200		MOVE B,3(Z)
01300		FMPR B,3(Y)
01400		FADR A,B
01500		POPR 3
01600		BEND
     

00100		BEGIN TRANSF
00200		S←1
00300		M←2
00400		V1←3
00500		V2←4
00600		V3←5
00700		V4←6
00800		I←7
00900		R←11
01000		T←14
01100		V←13
01200	↑TRANSF:HRRZ R,-3(P)
01300		HRRZ T,-2(P)
01400		HRRZ V,-1(P)
01500		ADDI R,3
01600		ADDI T,14
01700		MOVEI I,3
01800		MOVE V1,(V)
01900		MOVE V2,1(V)
02000		MOVE V3,2(V)
02100		MOVE V4,3(V)
02200	
02300	L1:	MOVE S,V1
02400		FMPR S,(T)
02500		MOVE M,V2
02600		FMPR M,1(T)
02700		FADR S,M
02800		MOVE M,V3
02900		FMPR M,2(T)
03000		FADR S,M
03100		MOVE M,V4
03200		FMPR M,3(T)
03300		FADR S,M
03400		MOVEM S,(R)
03500		SOJ R,
03600		SUBI T,4
03700		SOJG I,L1
03800	
03900		FMPR V1,(T)
04000		FMPR V2,1(T)
04100		FADR V1,V2
04200		FMPR V3,2(T)
04300		FADR V1,V3
04400		FMPR V4,3(T)
04500		FADR V1,V4
04600		MOVEM V1,(R)
04700		POPR 4
04800		BEND
     

00100		BEGIN SCALE
00200	↑MOVEV:	AOBJN P,.+1
00300		SKIPA Q,[JRST @3(P)]
00400	↑SCALE:MOVE Q,[JFCL]
00500		HRRZ Z,-3(P)
00600		HRRZ Y,-2(P)
00700		HRRZI X,3(Z)
00800		CAIN Z,(Y)
00900		JRST MOVED
01000		HRLI Z,(Y)
01100		BLT Z,(X)
01200	MOVED:	SUB P,X44
01300		XCT Q
01400		MOVE A,3(P)
01500		FMPRM A,-1(X)
01600		FMPRM A,-2(X)
01700		FMPRM A,-3(X)
01800		JRST @4(P)
01900		BEND
     

00100		BEGIN MOVET
00200	↑MOVET:	HRRZ Z,-2(P)
00300		HRL Z,-1(P)
00400		HRRZI Y,17(Z)
00500		BLT Z,(Y)
00600		POPR 3
00700		BEND
     

00100		BEGIN TRANSP
00200	↑TRANSP:HRRZ Z,-2(P)
00300		HRL Y,-1(P)
00400		HRRI Y,MLT
00500		BLT Y,MLT+17
00600		MOVE A,MLT
00700		MOVEM A,(Z)
00800		MOVE A,4+MLT
00900		MOVEM A,1(Z)
01000		MOVE A,10+MLT
01100		MOVEM A,2(Z)
01200		MOVE A,14+MLT
01300		MOVEM A,3(Z)
01400		MOVE A,1+MLT
01500		MOVEM A,4(Z)
01600		MOVE A,5+MLT
01700		MOVEM A,5(Z)
01800		MOVE A,11+MLT
01900		MOVEM A,6(Z)
02000		MOVE A,15+MLT
02100		MOVEM A,7(Z)
02200		MOVE A,2+MLT
02300		MOVEM A,10(Z)
02400		MOVE A,6+MLT
02500		MOVEM A,11(Z)
02600		MOVE A,12+MLT
02700		MOVEM A,12(Z)
02800		MOVE A,16+MLT
02900		MOVEM A,13(Z)
03000		MOVE A,3+MLT
03100		MOVEM A,14(Z)
03200		MOVE A,7+MLT
03300		MOVEM A,15(Z)
03400		MOVE A,13+MLT
03500		MOVEM A,16(Z)
03600		MOVE A,17+MLT
03700		MOVEM A,17(Z)
03800		POPR 3
03900		BEND
     

00100		BEGIN UNIT
00200	↑UNIT:	HRRZ Z,-2(P)
00300		HRRZ X,-1(P)
00400		MOVE AA,(X)
00500		MOVEM AA,(Z)
00600		FMPR AA,AA
00700		MOVE B,1(X)
00800		MOVEM B,1(Z)
00900		FMPR B,B
01000		FADR AA,B
01100		MOVE B,2(X)
01200		MOVEM B,2(Z)
01300		FMPR B,B
01400		FADR AA,B
01500		PUSH P,AA
01600		PUSHJ P,SQRT
01700		HRRZ X,-1(P)
01800		SKIPGE 3(X)
01900		MOVN A,A
02000		HRRZ Z,-2(P)
02100		MOVEM A,3(Z)
02200		POPR 3
02300		BEND
02400	
02500		BEGIN NORMAL
02600	↑NORMAL:HRRZ X,-1(P)
02700		MOVE A,(X)
02800		FMPR A,A
02900		MOVE B,1(X)
03000		FMPR B,B
03100		FADR A,B
03200		MOVE B,2(X)
03300		FMPR B,B
03400		FADR A,B
03500		PUSH P,A
03600		PUSHJ P,SQRT
03700		HRRZ X,-1(P)
03800		HRRZ Z,-2(P)
03900		MOVE B,(X)
04000		FDVR B,A
04100		MOVEM B,(Z)
04200		MOVE B,1(X)
04300		FDVR B,A
04400		MOVEM B,1(Z)
04500		MOVE B,2(X)
04600		FDVR B,A
04700		MOVEM B,2(Z)
04800		MOVE B,3(X)
04900		FDVR B,A
05000		MOVEM B,3(Z)
05100		POPR 3
05200		BEND
     

00100		BEGIN IDENTITY
00200	↑IDENTI:HRRZ Z,-1(P)
00300		HRRZI Y,17(Z)
00400		HRLI Z,[FOR A IN (1.0,0,0,0,0,1.0,0,0,0,0,1.0,0,0,0,0,1.0)
00500			{A
00600			⎇]
00700		BLT Z,(Y)
00800		POPR 2
00900		BEND
     

00100		BEGIN SUB
00200	↑DIFFER:SKIPA Q,[FSBR A,B]
00300	↑PLUS:	MOVE Q,[FADR A,B]
00400		HRRZ X,-2(P)		;A
00500		HRRZ Y,-1(P)		;B
00600		HRRZ Z,-3(P)		;RESULT
00700		MOVE C,3(X)
00800		MOVE D,3(Y)
00900		MOVE A, (X)
01000		CAMN D,ONE
01100		TLO X,1
01200		MOVE B, (Y)
01300		CAMN C,ONE
01400		TLO X,2
01500		TLNN X,1
01600		FMPR A,D
01700		TLNN X,2
01800		FMPR B,C
01900		XCT Q
02000		MOVEM A, (Z)
02100		MOVE A,1(X)
02200		MOVE B,1(Y)
02300		TLNN X,1
02400		FMPR A,D
02500		TLNN X,2
02600		FMPR B,C
02700		XCT Q
02800		MOVEM A,1(Z)
02900		MOVE A,2(X)
03000		MOVE B,2(Y)
03100		TLNN X,1
03200		FMPR A,D
03300		TLNN X,2
03400		FMPR B,C
03500		XCT Q
03600		MOVEM A,2(Z)
03700		FMPR C,D
03800		MOVEM C,3(Z)
03900		POPR 4
04000		BEND
04100	
     

00100		BEGIN MAGNITUDE
00200	↑MAGNIT:HRRZ Z,-1(P)
00300		MOVE AA,(Z)
00400		FMPR AA,AA
00500		MOVE B,1(Z)
00600		FMPR B,B
00700		FADR AA,B
00800		MOVE B,2(Z)
00900		FMPR B,B
01000		FADR AA,B
01100		PUSH P,AA
01200		PUSHJ P,SQRT
01300		HRRZ Z,-1(P)
01400		FDVR A,3(Z)
01500		MOVM A,A
01600		POPR 2
01700		BEND
     

00100		BEGIN REDUCE
00200	↑REDUCE:HRRZ Z,-1(P)
00300		MOVSI B,(1.0)
00400		MOVSI A,(1.0)
00500		FDVR B,3(Z)
00600		MOVEM A,3(Z)
00700		HRRZI X,2(Z)
00800	L1:	FMPRM B,(X)
00900		CAIE X,(Z)
01000		SOJA X,L1
01100		POPR 2
01200		BEND
     

00100		BEGIN RESET
00200	↑RESET:HRRZ Z,-1(P)
00300		HRRZI X,3(Z)
00400		SETZB A,C
00500		MOVEI D,377
00600	L1:	MOVM B,(X)
00700		JUMPN B,.+2
00800		MOVSI B,(1.0)
00900		LSHC A,11
01000		CAIL A,(C)
01100		HRRI C,(A)
01200		CAIG A,(D)
01300		HRRI D,(A)
01400		CAIE X,(Z)
01500		SOJA X,L1
01600		ADDI C,(D)
01700		ASH C,-1
01800		MOVEI D,200
01900		SUBI D,(C)
02000		HRRZI X,3(Z)
02100	L2:	MOVE A,(X)
02200		FSC A,(D)
02300		MOVEM A,(X)
02400		CAIE X,(Z)
02500		SOJA X,L2
02600		POPR 2
02700		BEND
     

00100		BEGIN TRANSMULT
00200		S←1
00300		M←2
00400		A1←3
00500		A2←4
00600		A3←5
00700		A4←6
00800		I←7
00900		J←10
01000		R←11
01100		T←14
01200		U←13
01300	↑TIMES:HRL T,-1(P)
01400		HRRI T,MLT
01500		BLT T,MLT+17
01600		MOVEI T,MLT+3
01700		HRRZ U,-2(P)
01800		HRRZ R,-3(P)
01900		ADDI R,17
02000		ADDI U,14
02100		MOVEI I,4
02200	
02300	L1:	MOVEI J,3
02400	
02500		MOVE A1,(U)
02600		MOVE A2,1(U)
02700		MOVE A3,2(U)
02800		MOVE A4,3(U)
02900	L2:	MOVE S,A1
03000		FMPR S,(T)
03100		MOVE M,A2
03200		FMPR M,4(T)
03300		FADR S,M
03400		MOVE M,A3
03500		FMPR M,10(T)
03600		FADR S,M
03700		MOVE M,A4
03800		FMPR M,14(T)
03900		FADR S,M
04000		MOVEM S,(R)
04100		SOJ R,
04200		SOJ T,
04300		SOJG J,L2
04400	
04500		FMPR A1,(T)
04600		FMPR A2,4(T)
04700		FADR A1,A2
04800		FMPR A3,10(T)
04900		FADR A1,A3
05000		FMPR A4,14(T)
05100		FADR A1,A4
05200		MOVEM A1,(R)
05300		SOJ R,
05400		ADDI T,3
05500		SUBI U,4
05600		SOJG I,L1
05700	
05800		POPR 4
05900		BEND
     

00100		BEGIN INVERT
00200	↑INVERT:HRRZ Z,-2(P)		;RESULT
00300		HRL Y,-1(P)
00400		HRRI Y,MLT
00500		BLT Y,MLT+17
00600		MOVEI Y,MLT+2
00700		MOVN A,MLT+3
00800		MOVN B,MLT+7
00900		MOVN C,MLT+13
01000		HRRZI X,13(Z)
01100	L1:	MOVE FF,A
01200		FMPR FF,(Y)
01300		MOVE Q,B
01400		FMPR Q,4(Y)
01500		FADR FF,Q
01600		MOVE Q,C
01700		FMPR Q,10(Y)
01800		FADR FF,Q
01900		MOVEM FF,(X)
02000		SUBI X,4
02100		CAIG X,(Z)
02200		JRST L2
02300		SOJA Y,L1
02400	
02500	L2:	MOVE A,MLT
02600		MOVEM A,(Z)
02700		MOVE A,1+MLT
02800		MOVEM A,4(Z)
02900		MOVE A,2+MLT
03000		MOVEM A,10(Z)
03100		MOVE A,4+MLT
03200		MOVEM A,1(Z)
03300		MOVE A,5+MLT
03400		MOVEM A,5(Z)
03500		MOVE A,6+MLT
03600		MOVEM A,11(Z)
03700		MOVE A,10+MLT
03800		MOVEM A,2(Z)
03900		MOVE A,11+MLT
04000		MOVEM A,6(Z)
04100		MOVE A,12+MLT
04200		MOVEM A,12(Z)
04300	
04400		SETZM 14(Z)
04500		SETZM 15(Z)
04600		SETZM 16(Z)
04700		MOVSI A,(1.0)
04800		MOVEM A,17(Z)
04900		POPR 3
05000		BEND
     

00100		END